home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / wtjmarch.zip / DEBUGWIN.ZIP / DWDLL.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-21  |  2KB  |  89 lines
  1. LISTING 2: DWDLL.PAS
  2. This dynamic link library locates DebugWin's window and sends debugging messages to it. Because it's implemented as a DLL, you can call it from WinApps written in any language.
  3.  
  4. {$S-,R-}
  5.  
  6. library dwDLL;
  7.  
  8. uses
  9.   Strings, WinTypes, WinProcs;
  10.  
  11. const
  12.   dwTitle        = 'Debug Window';
  13.   wmsDebugString = 'wm_DebugString';
  14.   WeLoadedIt     : Boolean = False;
  15.  
  16. var
  17.   wm_DebugString : Word;
  18.   SaveExitProc   : Pointer;
  19.  
  20.   procedure dwSendMessage(Msg, wParam : Word;
  21.     lParam : LongInt); export;
  22.   const
  23.     DebugWindow : hWnd = 0;
  24.     Retried     : Boolean = False;
  25.   begin
  26.     if (DebugWindow = 0) and not IsWindow(DebugWindow)
  27.       then begin
  28.       DebugWindow := FindWindow('TPWinCrt', dwTitle);
  29.       if (DebugWindow = 0) and not Retried then begin
  30.         WinExec('DEBUGWIN.EXE', sw_ShowNoActivate);
  31.         DebugWindow := FindWindow('TPWinCrt', dwTitle);
  32.         WeLoadedIt := (DebugWindow <> 0);
  33.         Retried := True;
  34.       end;
  35.     end;
  36.  
  37.     if DebugWindow <> 0 then
  38.       if Msg = wm_Destroy then
  39.         PostMessage(DebugWindow, Msg, wParam, lParam)
  40.       else
  41.         SendMessage(DebugWindow, Msg, wParam, lParam);
  42.   end;
  43.  
  44.   procedure dwWriteBuf(Msg : PChar; Count : Word);
  45.     export;
  46.   begin
  47.     dwSendMessage(wm_DebugString, Count, LongInt(Msg));
  48.   end;
  49.  
  50.   procedure dwWrite(Msg : PChar); export;
  51.   begin
  52.     dwWriteBuf(Msg, StrLen(Msg));
  53.   end;
  54.  
  55.   procedure dwWriteLn(Msg : PChar); export;
  56.   begin
  57.     dwWrite(Msg);
  58.     dwWrite(^M^J);
  59.   end;
  60.  
  61.   procedure dwWriteChar(Ch : Char); export;
  62.   const
  63.     ChCopy : Char = #0;
  64.   begin
  65.     ChCopy := Ch;
  66.     dwWriteBuf(@Ch, 1);
  67.   end;
  68.  
  69.   procedure OurExitProc; far;
  70.   begin
  71.     ExitProc := SaveExitProc;
  72.     if (ExitCode <> wep_System_Exit) and WeLoadedIt
  73.       then
  74.       dwSendMessage(wm_Destroy, 0, 0);
  75.   end;
  76.  
  77. exports
  78.   dwSendMessage index 1,
  79.   dwWriteBuf    index 2,
  80.   dwWrite       index 3,
  81.   dwWriteLn     index 4,
  82.   dwWriteChar   index 5;
  83.  
  84. begin
  85.   wm_DebugString := RegisterWindowMessage(wmsDebugString);
  86.   SaveExitProc := ExitProc;
  87.   ExitProc     := @OurExitProc;
  88. end.
  89.